home *** CD-ROM | disk | FTP | other *** search
/ User's Choice Windows CD / User's Choice Windows CD (CMS Software)(1993).iso / windows5 / v11n18.zip / RANDFI.BAS < prev    next >
BASIC Source File  |  1992-01-27  |  5KB  |  127 lines
  1. DEFINT A-Z
  2.  
  3. DECLARE SUB OpenFile (FileName$, FieldData$(), FieldType(), FileNumber)
  4. DECLARE SUB GetData (FldData$(), FldText$(), FldType(), FileNum, RecNumber)
  5. DECLARE SUB PutData (FldData$(), FldText$(), FldType(), FileNum, RecNumber)
  6.  
  7. '--- These constants are not used, and are here only to show the type codes.
  8. CONST IntType% = -2             'integer
  9. CONST LongType% = -3            'long integer
  10. CONST SingleType% = -4          'single precision
  11. CONST CurrencyType% = -7        'BASIC PDS Currency
  12. CONST DoubleType% = -8          'double precision
  13.                                 'all positive numbers are string lengths
  14.  
  15. REDIM FieldArray$(1 TO 10)      'this holds the actual record data
  16. REDIM FieldName$(1 TO 10)       'this is for prompting the user only
  17. REDIM DataType(1 TO 10)         'this holds each field's data type
  18.  
  19. FOR X = 1 TO 10
  20.   READ FieldName$(X)            'read the field names for prompting
  21.   READ DataType(X)              'and the type of data each field is to hold
  22. NEXT
  23.  
  24. DATA CustNumber, -2             : 'this is an integer field
  25. DATA FirstName, 15              : 'these are all string fields
  26. DATA LastName, 15               : '(colons are needed to comment DATA lines)
  27. DATA Company, 32
  28. DATA Address, 32
  29. DATA City, 15
  30. DATA State, 2
  31. DATA Zip, 9
  32. DATA LastAmount, -8             : 'this is a double precision field
  33. DATA LastTax, -4                : 'this is a single precision field
  34.  
  35. CLS
  36. FOR X = 1 TO 10                 'enter the data for a record
  37.   PRINT FieldName$(X); ": ";    'print a prompt
  38.   LINE INPUT Text$(X)           'then accept the field data as plain text
  39. NEXT
  40.  
  41. FileName$ = "TESTFILE.DAT"      'the name of our test file
  42. FileNum = FREEFILE              'get next available number and open the file
  43. CALL OpenFile(FileName$, FieldArray$(), DataType(), FileNum)
  44.  
  45. RecordNum = 1                   'write the data in Text$() to record 1
  46. CALL PutData(FieldArray$(), Text$(), DataType(), FileNum, RecordNum)
  47. CLOSE #FileNum                  'close the file to prove this is working
  48.  
  49. FileNum = FREEFILE              'open the file again and read the data
  50. CALL OpenFile(FileName$, FieldArray$(), DataType(), FileNum)
  51. CALL GetData(FieldArray$(), Text$(), DataType(), FileNum, RecordNum)
  52.  
  53. PRINT : PRINT                   'kick out a couple of blank lines
  54. FOR X = 1 TO 10                 'print the data for a record
  55.   PRINT FieldName$(X); ": ";    'print the field name
  56.   PRINT Text$(X)                'then print the field data as text
  57. NEXT
  58.  
  59. SUB GetData (FldData$(), FldText$(), FldType(), FileNumber, RecNumber) STATIC
  60.  
  61.   GET #FileNumber, RecNumber            'first read the record from disk
  62.  
  63.   FOR X = 1 TO UBOUND(FldData$)         'process all of the fields
  64.     SELECT CASE FldType(X)              'based on their data type
  65.       CASE -2                           'integer
  66.         FldText$(X) = STR$(CVI(FldData$(X)))
  67.       CASE -3                           'long integer
  68.         FldText$(X) = STR$(CVL(FldData$(X)))
  69.       CASE -4                           'single precision
  70.         FldText$(X) = STR$(CVS(FldData$(X)))
  71.       CASE -7                           'BASIC PDS Currency
  72.         'FldText$(X) = STR$(CVC(FldData$(X)))
  73.       CASE -8                           'double precision
  74.         FldText$(X) = STR$(CVD(FldData$(X)))
  75.       CASE ELSE                         'string
  76.         FldText$(X) = RTRIM$(FldData$(X))       'trim trailing blanks
  77.     END SELECT
  78.   NEXT
  79.  
  80. END SUB
  81.  
  82. SUB OpenFile (FileName$, FldData$(), FldType(), FileNumber) STATIC
  83.  
  84.   RecLength = 0                         'build the record length
  85.   TotalFields = UBOUND(FldData$)        'and number of fields
  86.  
  87.   FOR X = 1 TO TotalFields              'go through once to get the length
  88.     RecLength = RecLength + ABS(FldType(X))
  89.   NEXT
  90.  
  91.   OPEN FileName$ FOR RANDOM AS #FileNumber LEN = RecLength
  92.  
  93.   RecLength = 0                         'build the record structure
  94.   FOR X = 1 TO TotalFields
  95.     ThisLength = ABS(FldType(X))            'get the field length
  96.     IF FldType(X) = -3 THEN ThisLength = 4  'special test for long integers
  97.     IF FldType(X) = -7 THEN ThisLength = 8  'special test for Currency data
  98.     FIELD #FileNumber, RecLength AS Dummy$, ThisLength AS FldData$(X)
  99.     RecLength = RecLength + ThisLength
  100.   NEXT
  101.  
  102. END SUB
  103.  
  104. SUB PutData (FldData$(), FldText$(), FldType(), FileNumber, RecNumber) STATIC
  105.  
  106.   FOR X = 1 TO UBOUND(FldData$)         'process all of the fields
  107.     SELECT CASE FldType(X)              'based on their data type
  108.       CASE -2                           'integer
  109.         LSET FldData$(X) = MKI$(VAL(FldText$(X)))
  110.       CASE -3                           'long integer
  111.         LSET FldData$(X) = MKL$(VAL(FldText$(X)))
  112.       CASE -4                           'single precision
  113.         LSET FldData$(X) = MKS$(VAL(FldText$(X)))
  114.       CASE -7                           'BASIC PDS Currency
  115.         'LSET FldData$(X) = MKC$(VAL(FldText$(X)))
  116.       CASE -8                           'double precision
  117.         LSET FldData$(X) = MKD$(VAL(FldText$(X)))
  118.       CASE ELSE                         'string
  119.         LSET FldData$(X) = FldText$(X)
  120.     END SELECT
  121.   NEXT
  122.  
  123.   PUT #FileNumber, RecNumber            'finally, write the record to disk
  124.  
  125. END SUB
  126.  
  127.